Aminet 39/Aminet 39 (2000)(Schatztruhe)[!][Oct 2000].iso/Aminet/gfx/edit/PfPaint_V2.lha/PerfectPaint/rexx/line/Funny_Line.rx

Text File | 1999-12-10 | 3.8 KB | 284 lines

/*Line Crenel
    It's just an adaptation from some TVPaint macros
*/

    options results
  parse ARG Port x1 y1 x2 y2 b


    ADDRESS COMMAND
    type=0
    if EXISTS('PerfectPaint:Prefs/Rexx_Prefs/Funny_Line') THEN DO
        IF OPEN('lfile','PerfectPaint:Prefs/Rexx_Prefs/Funny_Line', "R") then DO
            type = READLN('lfile')
            CALL CLOSE('lfile')
        END
    END

  ADDRESS value Port
    pp_DialogInit 250 60 "*Funny*Line*" 1
        pp_Cycle 0 100 8 100 16 "Type" 1 "Crenel|Cut|Jagged|Shaky" type
    pp_Dialog
    rc=result
    if rc=0 then
        do
            EXIT
        end

    pp_GetDialog 0
    type=result

    CALL SavePrefs('Funny_Line',type)
    ADDRESS value Port

    pp_updateUndo

if type=0 then DO
    pp_STARTpoly
    l=20;w=5;x=x1;y=y1;iy=1;dy=y2-y1
    if (dy<0) then
    do
        dy=-dy;iy=-1
    end
    ix=1;dx=x2-x1
    if (dx<0) then
    do
        dx=-dx;ix=-1
    end
    xb=x;yb=y;xa=x;ya=y;c=1
    if (dx>dy) then
    do
        d=dx
        do while (x~==x2)
            x=x+ix;d=d-dy
            if (d<0) then
            do
                y=y+iy;d=d+dx
            end
            if((x%l)*l == x) then
            do
                if (c==1) then
                do
                    pp_Addpoly xb yb-w;pp_ADDpoly x y-w;pp_ADDpoly x y-w
                    c=0
                end
                else
                do
                    pp_ADDpoly xb yb+w;pp_ADDpoly x y+w;pp_ADDpoly x y-w
                    c=1
                end
                xb=x;yb=y
            end
        end
    end
    else
    do
        d=dy
        do while (y ~==y2)
            y=y+iy;d=d-dx
            if (d<0) then
            do
                x=x+ix;d=d+dy
            end
            if((y%l)*l == y) then
            do
                if (c==1) then
                do
                    pp_ADDpoly xb-w yb;pp_ADDpoly x-w y;pp_ADDpoly x+w y
                    c=0
                end
                else
                do
                    pp_ADDpoly xb+w yb;pp_ADDpoly x+w y;pp_ADDpoly x-w y
                    c=1
                end
                xb=x;yb=y
            end
        end
    end
    pp_ENDpoly
END

if type=1 then DO
    l=20;x=x1;y=y1;iy=1;dy=y2-y1
    if (dy<0) then
    do
        dy=-dy;iy=-1
    end
    ix=1;dx=x2-x1
    if (dx<0) then
    do
        dx=-dx;ix=-1
    end
    xb=x;yb=y;xa=x;ya=y;c=1
    if (dx>dy) then
    do
        d=dx
        do while (x~==x2)
            x=x+ix;d=d-dy
            if (d<0) then
            do
                y=y+iy;d=d+dx
            end
            if((x%l)*l == x) then
            do
                if (c==1) then
                do
                    pp_line xb yb x y;c=0
                end
                else c=1
                xb=x;yb=y
            end
        end
    end
    else
    do
        d=dy
        do while (y ~==y2)
            y=y+iy;d=d-dx
            if (d<0) then
            do
                x=x+ix;d=d+dy
            end
            if((y%l)*l == y) then
            do
                if (c==1) then
                do
                    pp_line xb yb x y;c=0
                end
                else c=1
                xb=x;yb=y
            end
        end
    end
END

if type=2 then DO
    l=10;w=5;x=x1;y=y1;iy=1;dy=y2-y1
    if (dy<0) then
    do
        dy=-dy;iy=-1
    end
    ix=1;dx=x2-x1
    if (dx<0) then
    do
        dx=-dx;ix=-1
    end
    xb=x;yb=y;xa=x;ya=y;c=1
    if (dx>dy) then
    do
        d=dx
        do while (x~==x2)
            x=x+ix;d=d-dy
            if (d<0) then
            do
                y=y+iy;d=d+dx
            end
            if((x%l)*l == x) then
            do
                if (c==1) then
                do
                    pp_line xb yb+w x y-w;c=0
                end
                else
                do
                    pp_line xb yb-w x y+w;c=1
                end
                xb=x;yb=y
            end
        end
    end
    else
    do
        d=dy
        do while (y ~==y2)
            y=y+iy;d=d-dx
            if (d<0) then
            do
                x=x+ix;d=d+dy
            end
            if((y%l)*l == y) then
            do
                if (c==1) then
                do
                    pp_line xb+w yb x-w y;c=0
                end
                else
                do
                    pp_line xb-w yb x+w y;c=1
                end
                xb=x;yb=y
            end
        end
    end
END

if type=3 then DO
    w=5;l=5;x=x1;y=y1;iy=1;dy=y2-y1
    if (dy<0) then
    do
        dy=-dy;iy=-1
    end
    ix=1;dx=x2-x1
    if (dx<0) then
    do
        dx=-dx;ix=-1
    end
    xb=x;yb=y;xa=x;ya=y
    if (dx>dy) then
    do
        d=dx
        do while (x~==x2)
            x=x+ix;d=d-dy
            if (d<0) then
            do
                y=y+iy;d=d+dx
            end
            if((x%l)*l == x) then
            do
                xa=x+random(0,w,time('S'));ya=y+random(0,w,time('S'))
                pp_line xb yb xa ya;xb=xa;yb=ya
            end
        end
    end
    else
    do
        d=dy
        do while (y ~==y2)
            y=y+iy;d=d-dx
            if (d<0) then
            do
                x=x+ix;d=d+dy
            end
            if((y%l)*l == y) then
            do
                xa=x+random(0,w);ya=y+random(0,w)
                pp_line xa ya xb yb;xb=xa;yb=ya
            end
        end
    end
END

EXIT


SavePrefs: PROCEDURE

    Prefname='PerfectPaint:Prefs/Rexx_Prefs/'||ARG(1)

    if EXISTS(Prefname) THEN DO
        ADDRESS COMMAND
        'delete >nil: '||Prefname
    END

    IF OPEN('pfile',PrefName,'W') THEN DO

    do i=2 to ARG()
        CALL WRITELN('pfile',ARG(i))
    end

    CALL CLOSE('pfile')

RETURN